home *** CD-ROM | disk | FTP | other *** search
/ PC Open 102 / PC Open 102 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / DBD / SQLite.pm
Encoding:
Perl POD Document  |  2003-08-23  |  14.1 KB  |  537 lines
  1. # $Id: SQLite.pm,v 1.35 2003/08/23 10:54:50 matt Exp $
  2.  
  3. package DBD::SQLite;
  4. use strict;
  5.  
  6. use DBI;
  7.  
  8. use vars qw($err $errstr $state $drh $VERSION @ISA);
  9. $VERSION = '0.28';
  10.  
  11. use DynaLoader();
  12. @ISA = ('DynaLoader');
  13.  
  14. __PACKAGE__->bootstrap($VERSION);
  15.  
  16. $drh = undef;
  17.  
  18. sub driver {
  19.     return $drh if $drh;
  20.     my ($class, $attr) = @_;
  21.  
  22.     $class .= "::dr";
  23.  
  24.     $drh = DBI::_new_drh($class, {
  25.         Name        => 'SQLite',
  26.         Version     => $VERSION,
  27.         Attribution => 'DBD::SQLite by Matt Sergeant',
  28.     });
  29.  
  30.     return $drh;
  31. }
  32.  
  33. sub CLONE {
  34.     undef $drh;
  35. }
  36.  
  37. package DBD::SQLite::dr;
  38.  
  39. sub connect {
  40.     my ($drh, $dbname, $user, $auth, $attr) = @_;
  41.  
  42.     my $dbh = DBI::_new_dbh($drh, {
  43.         Name => $dbname,
  44.         });
  45.  
  46.     my $real_dbname = $dbname;
  47.     if ($dbname =~ /=/) {
  48.         foreach my $attrib (split(/;/, $dbname)) {
  49.             my ($k, $v) = split(/=/, $attrib, 2);
  50.             if ($k eq 'dbname') {
  51.                 $real_dbname = $v;
  52.             }
  53.             else {
  54.                 # TODO: add to attribs
  55.             }
  56.         }
  57.     }
  58.     DBD::SQLite::db::_login($dbh, $real_dbname, $user, $auth)
  59.         or return undef;
  60.  
  61.     return $dbh;
  62. }
  63.  
  64. package DBD::SQLite::db;
  65.  
  66. sub prepare {
  67.     my ($dbh, $statement, @attribs) = @_;
  68.  
  69.     my $sth = DBI::_new_sth($dbh, {
  70.         Statement => $statement,
  71.     });
  72.  
  73.     DBD::SQLite::st::_prepare($sth, $statement, @attribs)
  74.         or return undef;
  75.  
  76.     return $sth;
  77. }
  78.  
  79.  
  80. sub table_info {
  81.     my ($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
  82.     # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
  83.     # Based on DBD::Oracle's
  84.     # See also http://www.ch-werner.de/sqliteodbc/html/sqliteodbc_8c.html#a117
  85.  
  86.     my @Where = ();
  87.     my $Sql;
  88.     if ( $CatVal eq '%' && $SchVal eq '' && $TblVal eq '') { # Rule 19a
  89.             $Sql = <<'SQL';
  90. SELECT NULL TABLE_CAT
  91.      , NULL TABLE_SCHEM
  92.      , NULL TABLE_NAME
  93.      , NULL TABLE_TYPE
  94.      , NULL REMARKS
  95. SQL
  96.     }
  97.     elsif ( $SchVal eq '%' && $CatVal eq '' && $TblVal eq '') { # Rule 19b
  98.             $Sql = <<'SQL';
  99. SELECT NULL      TABLE_CAT
  100.      , NULL      TABLE_SCHEM
  101.      , NULL      TABLE_NAME
  102.      , NULL      TABLE_TYPE
  103.      , NULL      REMARKS
  104. SQL
  105.     }
  106.     elsif ( $TypVal eq '%' && $CatVal eq '' && $SchVal eq '' && $TblVal eq '') { # Rule 19c
  107.             $Sql = <<'SQL';
  108. SELECT NULL TABLE_CAT
  109.      , NULL TABLE_SCHEM
  110.      , NULL TABLE_NAME
  111.      , t.tt TABLE_TYPE
  112.      , NULL REMARKS
  113. FROM (
  114.      SELECT 'TABLE' tt                  UNION
  115.      SELECT 'VIEW' tt                   UNION
  116.      SELECT 'LOCAL TEMPORARY' tt
  117. ) t
  118. ORDER BY TABLE_TYPE
  119. SQL
  120.     }
  121.     else {
  122.             $Sql = <<'SQL';
  123. SELECT *
  124. FROM
  125. (
  126. SELECT NULL         TABLE_CAT
  127.      , NULL         TABLE_SCHEM
  128.      , tbl_name     TABLE_NAME
  129.      ,              TABLE_TYPE
  130.      , NULL         REMARKS
  131.      , sql          sqlite_sql
  132. FROM (
  133.     SELECT tbl_name, upper(type) TABLE_TYPE, sql
  134.     FROM sqlite_master
  135.     WHERE type IN ( 'table','view')
  136. UNION ALL
  137.     SELECT tbl_name, 'LOCAL TEMPORARY' TABLE_TYPE, sql
  138.     FROM sqlite_temp_master
  139.     WHERE type IN ( 'table','view')
  140. UNION ALL
  141.     SELECT 'sqlite_master'      tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
  142. UNION ALL
  143.     SELECT 'sqlite_temp_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
  144. )
  145. )
  146. SQL
  147.             if ( defined $TblVal ) {
  148.                     push @Where, "TABLE_NAME  LIKE '$TblVal'";
  149.             }
  150.             if ( defined $TypVal ) {
  151.                     my $table_type_list;
  152.                     $TypVal =~ s/^\s+//;
  153.                     $TypVal =~ s/\s+$//;
  154.                     my @ttype_list = split (/\s*,\s*/, $TypVal);
  155.                     foreach my $table_type (@ttype_list) {
  156.                             if ($table_type !~ /^'.*'$/) {
  157.                                     $table_type = "'" . $table_type . "'";
  158.                             }
  159.                             $table_type_list = join(", ", @ttype_list);
  160.                     }
  161.                     push @Where, "TABLE_TYPE IN (\U$table_type_list)"
  162.             if $table_type_list;
  163.             }
  164.             $Sql .= ' WHERE ' . join("\n   AND ", @Where ) . "\n" if @Where;
  165.             $Sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n";
  166.     }
  167.     my $sth = $dbh->prepare($Sql) or return undef;
  168.     $sth->execute or return undef;
  169.     $sth;
  170. }
  171.  
  172.  
  173. sub primary_key_info {
  174.     my($dbh, $catalog, $schema, $table) = @_;
  175.  
  176.     my @pk_info;
  177.  
  178.     my $sth_tables = $dbh->table_info($catalog, $schema, $table, '');
  179.  
  180.     # this is a hack but much simpler than using pragma index_list etc
  181.     # also the pragma doesn't list 'INTEGER PRIMARK KEY' autoinc PKs!
  182.     while ( my $row = $sth_tables->fetchrow_hashref ) {
  183.         my $sql = $row->{sqlite_sql} or next;
  184.     next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si;
  185.     my @pk = split /\s*,\s*/, $2 || '';
  186.     unless (@pk) {
  187.         my $prefix = $1;
  188.         $prefix =~ s/.*create\s+table\s+.*?\(//i;
  189.         $prefix = (split /\s*,\s*/, $prefix)[-1];
  190.         @pk = (split /\s+/, $prefix)[0]; # take first word as name
  191.     }
  192.     #warn "GOT PK $row->{TABLE_NAME} (@pk)\n";
  193.     my $key_seq = 0;
  194.     for my $pk_field (@pk) {
  195.         push @pk_info, {
  196.         TABLE_SCHEM => $row->{TABLE_SCHEM},
  197.         TABLE_NAME  => $row->{TABLE_NAME},
  198.         COLUMN_NAME => $pk_field,
  199.         KEY_SEQ => ++$key_seq,
  200.         PK_NAME => 'PRIMARY KEY',
  201.         };
  202.     }
  203.     }
  204.  
  205.     my $sponge = DBI->connect("DBI:Sponge:", '','')
  206.         or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
  207.     my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME);
  208.     my $sth = $sponge->prepare("column_info $table", {
  209.         rows => [ map { [ @{$_}{@names} ] } @pk_info ],
  210.         NUM_OF_FIELDS => scalar @names,
  211.         NAME => \@names,
  212.     }) or return $dbh->DBI::set_err($sponge->err(), $sponge->errstr());
  213.     return $sth;
  214. }
  215.  
  216. sub type_info_all {
  217.     my ($dbh) = @_;
  218. return; # XXX code just copied from DBD::Oracle, not yet thought about
  219.     my $names = {
  220.     TYPE_NAME    => 0,
  221.     DATA_TYPE    => 1,
  222.     COLUMN_SIZE    => 2,
  223.     LITERAL_PREFIX    => 3,
  224.     LITERAL_SUFFIX    => 4,
  225.     CREATE_PARAMS    => 5,
  226.     NULLABLE    => 6,
  227.     CASE_SENSITIVE    => 7,
  228.     SEARCHABLE    => 8,
  229.     UNSIGNED_ATTRIBUTE    => 9,
  230.     FIXED_PREC_SCALE    =>10,
  231.     AUTO_UNIQUE_VALUE    =>11,
  232.     LOCAL_TYPE_NAME    =>12,
  233.     MINIMUM_SCALE    =>13,
  234.     MAXIMUM_SCALE    =>14,
  235.     SQL_DATA_TYPE    =>15,
  236.     SQL_DATETIME_SUB=>16,
  237.     NUM_PREC_RADIX    =>17,
  238.     };
  239.     my $ti = [
  240.       $names,
  241.       [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3,
  242.     undef, '0', '0', undef, undef, undef, 1, undef, undef
  243.       ],
  244.       [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3,
  245.     '0', '0', '0', undef, '0', 38, 3, undef, 10
  246.       ],
  247.       [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3,
  248.     '0', '0', '0', undef, undef, undef, 8, undef, 10
  249.       ],
  250.       [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3,
  251.     undef, '0', '0', undef, '0', '0', 11, undef, undef
  252.       ],
  253.       [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3,
  254.     undef, '0', '0', undef, undef, undef, 12, undef, undef
  255.       ]
  256.     ];
  257.     return $ti;
  258. }
  259.  
  260.  
  261. 1;
  262. __END__
  263.  
  264. =head1 NAME
  265.  
  266. DBD::SQLite - Self Contained RDBMS in a DBI Driver
  267.  
  268. =head1 SYNOPSIS
  269.  
  270.   use DBI;
  271.   my $dbh = DBI->connect("dbi:SQLite:dbname=dbfile","","");
  272.  
  273. =head1 DESCRIPTION
  274.  
  275. SQLite is a public domain RDBMS database engine that you can find
  276. at http://www.hwaci.com/sw/sqlite/.
  277.  
  278. Rather than ask you to install SQLite first, because SQLite is public
  279. domain, DBD::SQLite includes the entire thing in the distribution. So
  280. in order to get a fast transaction capable RDBMS working for your
  281. perl project you simply have to install this module, and B<nothing>
  282. else.
  283.  
  284. SQLite supports the following features:
  285.  
  286. =over 4
  287.  
  288. =item Implements a large subset of SQL92
  289.  
  290. See http://www.hwaci.com/sw/sqlite/lang.html for details.
  291.  
  292. =item A complete DB in a single disk file
  293.  
  294. Everything for your database is stored in a single disk file, making it
  295. easier to move things around than with DBD::CSV.
  296.  
  297. =item Atomic commit and rollback
  298.  
  299. Yes, DBD::SQLite is small and light, but it supports full transactions!
  300.  
  301. =item Extensible
  302.  
  303. User-defined aggregate or regular functions can be registered with the
  304. SQL parser.
  305.  
  306. =back
  307.  
  308. There's lots more to it, so please refer to the docs on the SQLite web
  309. page, listed above, for SQL details. Also refer to L<DBI> for details
  310. on how to use DBI itself.
  311.  
  312. =head1 CONFORMANCE WITH DBI SPECIFICATION
  313.  
  314. The API works like every DBI module does. Please see L<DBI> for more
  315. details about core features.
  316.  
  317. Currently many statement attributes are not implemented or are
  318. limited by the typeless nature of the SQLite database.
  319.  
  320. =head1 DRIVER PRIVATE ATTRIBUTES
  321.  
  322. =head2 Database Handle Attributes
  323.  
  324. =over 4
  325.  
  326. =item sqlite_version
  327.  
  328. Returns the version of the SQLite library which DBD::SQLite is using, e.g., "2.8.0".
  329.  
  330. =item sqlite_encoding
  331.  
  332. Returns either "UTF-8" or "iso8859" to indicate how the SQLite library was compiled.
  333.  
  334. =item sqlite_handle_binary_nulls
  335.  
  336. Set this attribute to 1 to transparently handle binary nulls in quoted
  337. and returned data.
  338.  
  339. B<NOTE:> This will cause all backslash characters (C<\>) to be doubled
  340. up in all columns regardless of whether or not they contain binary
  341. data or not. This may break your database if you use it from another
  342. application. This does not use the built in sqlite_encode_binary
  343. and sqlite_decode_binary functions, which may be considered a bug.
  344.  
  345. =back
  346.  
  347. =head1 DRIVER PRIVATE METHODS
  348.  
  349. =head2 $dbh->func('last_insert_rowid')
  350.  
  351. This method returns the last inserted rowid. If you specify an INTEGER PRIMARY
  352. KEY as the first column in your table, that is the column that is returned.
  353. Otherwise, it is the hidden ROWID column. See the sqlite docs for details.
  354.  
  355. =head2 $dbh->func( $name, $argc, $func_ref, "create_function" )
  356.  
  357. This method will register a new function which will be useable in SQL
  358. query. The method's parameters are:
  359.  
  360. =over
  361.  
  362. =item $name
  363.  
  364. The name of the function. This is the name of the function as it will
  365. be used from SQL.
  366.  
  367. =item $argc
  368.  
  369. The number of arguments taken by the function. If this number is -1,
  370. the function can take any number of arguments.
  371.  
  372. =item $func_ref
  373.  
  374. This should be a reference to the function's implementation.
  375.  
  376. =back
  377.  
  378. For example, here is how to define a now() function which returns the
  379. current number of seconds since the epoch:
  380.  
  381.     $dbh->func( 'now', 0, sub { return time }, 'create_function' );
  382.  
  383. After this, it could be use from SQL as:
  384.  
  385.     INSERT INTO mytable ( now() );
  386.  
  387. =head2 $dbh->func( $name, $argc, $obj, 'create_aggregate' )
  388.  
  389. This method will register a new aggregate function which can then used
  390. from SQL. The method's parameters are:
  391.  
  392. =over
  393.  
  394. =item $name
  395.  
  396. The name of the aggregate function, this is the name under which the
  397. function will be available from SQL.
  398.  
  399. =item $argc
  400.  
  401. This is an integer which tells the SQL parser how many arguments the
  402. function takes. If that number is -1, the function can take any number
  403. of arguments.
  404.  
  405. =item $obj
  406.  
  407. This is the object which implements the aggregator interface.
  408.  
  409. =back
  410.  
  411. The aggregator interface consists of defining three methods:
  412.  
  413. =over
  414.  
  415. =item init()
  416.  
  417. This method will be called once before any values are seen.
  418.  
  419. =item step(@_)
  420.  
  421. This method will be called once for each rows in the aggregate.
  422.  
  423. =item finalize()
  424.  
  425. This method will be called once all rows in the aggregate were
  426. processed and it should return the aggregate function's result. When
  427. there is no rows in the aggregate, finalize() will be called right
  428. after init().
  429.  
  430. =back
  431.  
  432. Here is a simple aggregate function which returns the variance
  433. (example adapted from pysqlite):
  434.  
  435.     package variance;
  436.  
  437.     sub new { bless [], shift; }
  438.  
  439.     sub init {
  440.         my $self = $_[0];
  441.  
  442.         @$self = ();
  443.     }
  444.  
  445.     sub step {
  446.         my ( $self, $value ) = @_;
  447.  
  448.         push @$self, $value;
  449.     }
  450.  
  451.     sub finalize {
  452.         my $self = $_[0];
  453.  
  454.         my $n = @$self;
  455.  
  456.         # Variance is NULL unless there is more than one row
  457.         return undef unless $n || $n == 1;
  458.  
  459.         my $mu = 0;
  460.         foreach my $v ( @$self ) {
  461.             $mu += $v;
  462.         }
  463.         $mu /= $n;
  464.  
  465.         my $sigma = 0;
  466.         foreach my $v ( @$self ) {
  467.             $sigma += ($x - $mu)**2;
  468.         }
  469.         $sigma = $sigma / ($n - 1);
  470.  
  471.         return $sigma;
  472.     }
  473.  
  474.     my $aggr = new variance();
  475.     $dbh->func( "variance", 1, $aggr, "create_aggregate" );
  476.  
  477. The aggregate function can then be used as:
  478.  
  479.     SELECT group_name, variance(score) FROM results
  480.     GROUP BY group_name;
  481.  
  482. =head1 NOTES
  483.  
  484. To access the database from the command line, try using dbish which comes with
  485. the DBI module. Just type:
  486.  
  487.   dbish dbi:SQLite:foo.db
  488.  
  489. On the command line to access the file F<foo.db>.
  490.  
  491. Alternatively you can install SQLite from the link above without conflicting
  492. with DBD::SQLite and use the supplied C<sqlite> command line tool.
  493.  
  494. =head1 PERFORMANCE
  495.  
  496. SQLite is fast, very fast. I recently processed my 72MB log file with it,
  497. inserting the data (400,000+ rows) by using transactions and only committing
  498. every 1000 rows (otherwise the insertion is quite slow), and then performing
  499. queries on the data.
  500.  
  501. Queries like count(*) and avg(bytes) took fractions of a second to return,
  502. but what surprised me most of all was:
  503.  
  504.   SELECT url, count(*) as count FROM access_log
  505.     GROUP BY url
  506.     ORDER BY count desc
  507.     LIMIT 20
  508.  
  509. To discover the top 20 hit URLs on the site (http://axkit.org), and it
  510. returned within 2 seconds. I'm seriously considering switching my log
  511. analysis code to use this little speed demon!
  512.  
  513. Oh yeah, and that was with no indexes on the table, on a 400MHz PIII.
  514.  
  515. For best performance be sure to tune your hdparm settings if you are
  516. using linux. Also you might want to set:
  517.  
  518.   PRAGMA default_synchronous = OFF
  519.  
  520. Which will prevent sqlite from doing fsync's when writing (which
  521. slows down non-transactional writes significantly) at the expense of some
  522. peace of mind. Also try playing with the cache_size pragma.
  523.  
  524. =head1 BUGS
  525.  
  526. Likely to be many, please use http://rt.cpan.org/ for reporting bugs.
  527.  
  528. =head1 AUTHOR
  529.  
  530. Matt Sergeant, matt@sergeant.org
  531.  
  532. =head1 SEE ALSO
  533.  
  534. L<DBI>.
  535.  
  536. =cut
  537.